perm filename ACCI.F4[P11,LCS]2 blob sn#585800 filedate 1981-05-13 generic text, type T, neo UTF8
C***** ACCI, DIAMND ***********
	SUBROUTINE ACCI
	COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
	COMMON/DAT/RAC(69),RDT(17),XAC(7),RNTE(22),RACCI(22),NACCI(3)
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSTFAC(0/7),RSTJ2
	COMMON /FONT/JFONT /PLTR/IPLT,RHT /POSI/STFF(0/7),JJ2,POS
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY
	EQUIVALENCE (R3,RJQ(1)),(J5,JQ(3)),(R5,RJQ(3))
	1,(R4,RJQ(2)),(RLVL,RJQ(20)),(R6,RJQ(4))

	RX=RMINI
	RR3=R3
	RR5=AMOD(R5,1.0)
	IF(RR5.NE.0)RR3=RR3-RR5*59.6*RMINI
C  TO SPACE OUT ACCIDS.
	IF(JACC.GT.3)GO TO 3121
C  DBL FLT(4) AND DBL SHRP(5)  ALWAYS USE 'DRAW' ROUTINE.
C ADD (#) ETC.
	IF(IPLT.LT.0)GO TO 3121
	IF(JFONT.NE.0)GO TO 3121
	NX=NACCI(JACC)
	CALL RDRAW(NX+1,RACCI(NX),RACCI,RMINI,RR3,CENTR,RMINI)
	RETURN
C  TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
3121	RA=R3
	R3=RR3
C	RJZ=AMOD(R4,100.0)
	J5=9
	IF(JACC.LT.6)GO TO 1
C NEXT FOR (#) ETC.
	R6=2.
	POS=POS+21.*RMINI
	RMINI=RMINI*2.0
C	R3=R3-3.*RMINI
	J5=99
1	J5=J5+JACC
	CALL DRWNT
	R3=RA
	RMINI=RX
	END
	SUBROUTINE DIAMND
	COMMON /INTGRS/JACC,JTAIL,JDOT,NTYPE,JSTEM,JWHOLE
	COMMON /WIDTH/WID1,WID2,WIDX
	COMMON/DAT/RACNT(69),RDOT(17),JXAC(7),RNOTE(22)
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /PLTR/IPLT,RHT,DIS,XDIS
	COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
	1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ
	EQUIVALENCE (R3,RJQ(1)),(J5,JQ(3)),(R4,RJQ(2)),(R6,RJQ(4))
	1,(R7,RJQ(5)),(RX4,JQ(19)),(ISTEM,JQ(20)),(J7,JQ(5)),(J6,JQ(4))
C DIAMOND NTS=180→279
	WIDX=WID1
C SET NOTE WIDTH FOR STEM ROUTINE
	 KL=8
	RG=12.0
C  FOR DIAMOND NOTES.
	RB=0
	IF(NTYPE.NE.3)GO TO 3
	KL=13
	RG=16.
	RB=7.*RMINI
C THESE FOR X-NOTE   =280→379
3	J4=R4
	RJZ=R4
	RX4=R4
	IF(J6.GE.0)GO TO 1
C NOW FOR BLACK DIAMOND (J6=-1)
	J6=0
	J5=7
	RQ=R7
	RG=CENTR
2	CALL DRWNT
	R7=RQ
	R4=RX4
	R6=0
	CENTR=RG
	RETURN

1	JT=1
C FOR DOUBLE-THICK X NOTES, HARMONICS.
	RH=R3
1253	CALL RDRAW(KL,RG,RNOTE,RMINI,RH,CENTR,RMINI)
	IF(JT.LT.0)RETURN
	IF(IPLT.GE.0)RETURN
	RH=RH-1.0
	JT=JT-1
	GO TO 1253
	END